home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / extension.c < prev    next >
C/C++ Source or Header  |  1995-10-13  |  10KB  |  382 lines
  1. /*Copyright (c) 1993 by Richard Kelsey and Jonathan Rees.  See file COPYING.*/
  2.  
  3.  
  4. /* Implementation of the vm-extension opcode.  This is completetly
  5.    optional; nothing in the standard system uses these features.
  6.    If you have ANSI C but not POSIX support, try compiling with -DPOSIX=0.
  7.  
  8.    fdopen: POSIX.1
  9.    getenv: POSIX.1, ANSI C
  10.    setuid, setgid: POSIX.1
  11.    popen: POSIX.2
  12.    floating point: POSIX.1, ANSI C (should we be linking with -lM or -lm?)
  13.    sprintf: POSIX.1, ANSI C
  14.    atof: POSIX.1, ANSI C
  15.    chroot: not standard
  16.  
  17.  */
  18.  
  19. #ifndef POSIX
  20. #  define POSIX 2
  21. #endif
  22.  
  23. #include "sysdep.h"
  24. #include "scheme48.h"
  25.  
  26. #include <math.h>
  27. #include <signal.h>
  28. #include <stdlib.h>
  29. #include <stdio.h>
  30. #include <string.h>
  31. #include <unistd.h>        /* setuid & setgid */
  32.  
  33. /* #include <fcntl.h>        /* for O_RDWR */
  34.  
  35. #define GREATEST_FIXNUM_VALUE ((1 << 29) - 1)
  36. #define LEAST_FIXNUM_VALUE (-1 << 29)
  37. #define PORT_INDEX(x) EXTRACT_FIXNUM(STOB_REF(x, 1))
  38. #define FOR_INPUT 1
  39. #define FOR_OUTPUT 2
  40.  
  41. FILE **port_to_stream(scheme_value);
  42.  
  43. typedef struct {
  44.   char b[sizeof(double)];
  45. } unaligned_double;
  46.  
  47. typedef union {
  48.   double f;
  49.   unaligned_double b;
  50. } float_or_bytes;
  51.  
  52.  
  53. /******************************************/
  54.  
  55. scheme_value
  56. extended_vm (long key, scheme_value value)
  57. {
  58.   double x, y;
  59.  
  60.   switch (key) {
  61.   
  62.     /* Cases 0 through 19 are reserved for the mobot system. */
  63.  
  64.   case 0:            /* read jumpers on 68000 board */
  65.     return ENTER_FIXNUM(0);
  66.  
  67. #if defined(SOCKET_SUPPORT)
  68.   case 20:
  69.     { extern int internet_stream_socket();
  70.       int s = internet_stream_socket();
  71.       return (s < 0) ? UNDEFINED : ENTER_FIXNUM(s);
  72.     }
  73.  
  74.   case 21:
  75.     { extern int socket_bind(int, int);
  76.       int port = socket_bind(EXTRACT_FIXNUM(value), 0);
  77.       return (port < 0) ? UNDEFINED : ENTER_FIXNUM(port);
  78.     }
  79.  
  80.   case 22:
  81.     { extern int socket_accept(int);
  82.       int fd = socket_accept(EXTRACT_FIXNUM(value));
  83.       return (fd < 0) ? UNDEFINED : ENTER_FIXNUM(fd);
  84.     }
  85.  
  86.   case 23:
  87.     if (!PAIRP(value)) return UNDEFINED;
  88.     { extern int socket_connect(char *, int);
  89.       char *hostname = &STRING_REF(CAR(value), 0);
  90.       long port = EXTRACT_FIXNUM(CDR(value));
  91.       int fd;
  92.       fd = socket_connect(hostname, port);
  93.       return (fd < 0) ? UNDEFINED : ENTER_FIXNUM(fd);
  94.     }
  95. #endif
  96.  
  97. #if POSIX
  98.   /* fdopen() support */
  99.   case 24:
  100.   case 25:
  101.     if (!PAIRP(value)) return UNDEFINED;
  102.     { scheme_value port = CAR(value);
  103.       long fd = EXTRACT_FIXNUM(CDR(value));
  104.       FILE **pstream = port_to_stream(port);
  105.       FILE *new_stream;
  106.  
  107.       if (pstream == NULL) return UNDEFINED;
  108.       new_stream = fdopen(fd, key == 24 ? "r" : "w");
  109.       if (new_stream == NULL) return UNDEFINED;
  110.       fclose(*pstream);
  111.       *pstream = new_stream;
  112.       return UNSPECIFIC;
  113.     }
  114. #endif /* POSIX */
  115.  
  116.   /* getenv() */
  117.   case 26: {
  118.     scheme_value env_var, result_buffer;
  119.     char *result;
  120.     size_t result_len;
  121.     
  122.     if (!PAIRP(value)) return UNDEFINED;
  123.     env_var = CAR(value);
  124.     result_buffer = CDR(value);
  125.     if (!STRINGP(env_var) || !STRINGP(result_buffer)) return UNDEFINED;
  126.     result = getenv(&STRING_REF(env_var, 0));
  127.     if (result == NULL)
  128.       return SCHFALSE;
  129.     result_len = strlen(result);
  130.     if (result_len > STRING_LENGTH(result_buffer))
  131.       return UNDEFINED;
  132.     strncpy(&STRING_REF(result_buffer, 0), result, result_len);
  133.     return ENTER_FIXNUM(result_len);
  134.   }
  135.  
  136. #if POSIX
  137.   case 27: {
  138.     /* This is intended for use by HTTP scripts... */
  139.     if (!PAIRP(value) || !FIXNUMP(CAR(value)) || !FIXNUMP(CDR(value)))
  140.       return UNDEFINED;
  141.     if (setgid(EXTRACT_FIXNUM(CDR(value))) != 0) {
  142.       perror("setgid");
  143.       return SCHFALSE; }
  144.     if (setuid(EXTRACT_FIXNUM(CAR(value))) != 0) {
  145.       perror("setuid");
  146.       return SCHFALSE; }
  147.     else
  148.       return SCHTRUE;
  149.   }
  150. #endif
  151.  
  152. #if defined(HAVE_CHROOT)
  153.   case 28: {
  154.     if (!STRINGP(value))
  155.       return UNDEFINED;
  156.     else if (chroot(&STRING_REF(value, 0)) != 0) {
  157.       perror("chroot");
  158.       return SCHFALSE; }
  159.     else
  160.       return SCHTRUE;
  161.   }
  162. #endif
  163.  
  164. #if POSIX >= 2
  165.   case 96: {
  166.     int status;
  167.     if (!STRINGP(value))
  168.       return UNDEFINED;
  169.     status = system(&STRING_REF(value, 0));
  170.     if (status == -1) {
  171.       perror("chroot");
  172.       return UNDEFINED; }
  173.     else
  174.       return ENTER_FIXNUM(status); /* cf. waitpid() */
  175.   }
  176.  
  177.   /* popen() support.  Rather kludgey; there's no pclose(), so
  178.      zombies will pile up. */
  179.   case 97:
  180.   case 98: {
  181.     if (!PAIRP(value)) return UNDEFINED;
  182.     { scheme_value port = CAR(value);
  183.       FILE **pstream = port_to_stream(port);
  184.       scheme_value command = CDR(value);
  185.       FILE *new_stream;
  186.       struct sigaction action;
  187.  
  188.       if (pstream == NULL) return UNDEFINED;
  189.  
  190.       action.sa_handler = SIG_IGN;
  191.       action.sa_flags = 0;
  192.       sigemptyset(&action.sa_mask);
  193.       sigaction(SIGPIPE, &action, NULL);
  194.  
  195.       new_stream = popen(&STRING_REF(command, 0), key == 97 ? "r" : "w");
  196.       if (new_stream == NULL) return UNDEFINED;
  197.       fclose(*pstream);
  198.       *pstream = new_stream;
  199.       return SCHTRUE;
  200.     }
  201.   }
  202. #endif /* POSIX.2 */
  203.  
  204.  
  205.   /* Floating point */
  206.  
  207. #define FLOP 100
  208. #define FLOP2(i) case FLOP+(i): \
  209.            if (!STOBP(value) || STOB_LLENGTH(value) != 2) \
  210.              return UNDEFINED;
  211. #define FLOP3(i) case FLOP+(i): \
  212.            if (!STOBP(value) || STOB_LLENGTH(value) != 3) \
  213.              return UNDEFINED;
  214.  
  215. #define get_arg(args,i) STOB_REF(args,(i))
  216. #define get_string_arg(args,i) (&STRING_REF(get_arg(args,i), 0))
  217.  
  218. #define get_float_arg(args, i, var) EXTRACT_FLOAT(get_arg(args, i), var)
  219. #define set_float_arg(args, i, val) SET_FLOAT(get_arg(args, i), val)
  220.  
  221. #define EXTRACT_FLOAT(stob, var) \
  222.   { scheme_value temp_ = (stob); \
  223.     float_or_bytes loser_; \
  224.     if (!STOBP(temp_)) return UNDEFINED; \
  225.     loser_.b = *(unaligned_double*)(&STOB_REF(temp_, 0)); \
  226.     (var) = loser_.f; }
  227.  
  228. #define SET_FLOAT(stob, val) \
  229.   { scheme_value temp_ = (stob); \
  230.     float_or_bytes loser_; \
  231.     if (!STOBP(temp_)) return UNDEFINED; \
  232.     loser_.f = (double)(val); \
  233.     *(unaligned_double*)(&STOB_REF(temp_, 0)) = loser_.b; }
  234.  
  235.   FLOP3(0) {
  236.     get_float_arg(value, 0, x);
  237.     get_float_arg(value, 1, y);
  238.     set_float_arg(value, 2, x + y);
  239.     return UNSPECIFIC;}
  240.   FLOP3(1) {
  241.     get_float_arg(value, 0, x);
  242.     get_float_arg(value, 1, y);
  243.     set_float_arg(value, 2, x - y);
  244.     return UNSPECIFIC;}
  245.   FLOP3(2) {
  246.     get_float_arg(value, 0, x);
  247.     get_float_arg(value, 1, y);
  248.     set_float_arg(value, 2, x * y);
  249.     return UNSPECIFIC;}
  250.   FLOP3(3) {
  251.     get_float_arg(value, 0, x);
  252.     get_float_arg(value, 1, y);
  253.     if (y == 0.0) return UNDEFINED;
  254.     set_float_arg(value, 2, x / y);
  255.     return UNSPECIFIC;}
  256.   FLOP2(4) {
  257.     get_float_arg(value, 0, x);
  258.     get_float_arg(value, 1, y);
  259.     return ENTER_BOOLEAN(x == y);}
  260.   FLOP2(5) {
  261.     get_float_arg(value, 0, x);
  262.     get_float_arg(value, 1, y);
  263.     return ENTER_BOOLEAN(x < y);}
  264.   FLOP2(6) {            /* fixnum->float */
  265.     scheme_value arg = get_arg(value, 0);
  266.     if (!FIXNUMP(arg)) return SCHFALSE;
  267.     set_float_arg(value, 1, EXTRACT_FIXNUM(arg));
  268.     return SCHTRUE;}
  269.   FLOP2(7) {            /* string->float */
  270.     char *str = get_string_arg(value, 0);
  271.     set_float_arg(value, 1, atof(str));
  272.     return UNSPECIFIC;}
  273.   FLOP2(8) {            /* float->string */
  274.     size_t len;
  275.     char *str = get_string_arg(value,1);
  276.     get_float_arg(value, 0, x);
  277.     sprintf(str, "%g", x);
  278.     len = strlen(str);
  279.     if (len > STRING_LENGTH(get_arg(value,1)))
  280.       /* unlikely but catastrophic */
  281.       fprintf(stderr, "printing float: output too long: %s\n",
  282.           str);
  283.     return ENTER_FIXNUM(len);}
  284.  
  285.     /* exp log sin cos tan asin acos atan sqrt */
  286.  
  287.   FLOP2(9) {
  288.     get_float_arg(value, 0, x);
  289.     set_float_arg(value, 1, exp(x));
  290.     return UNSPECIFIC;}
  291.   FLOP2(10) {
  292.     get_float_arg(value, 0, x);
  293.     set_float_arg(value, 1, log(x));
  294.     return UNSPECIFIC;}
  295.   FLOP2(11) {
  296.     get_float_arg(value, 0, x);
  297.     set_float_arg(value, 1, sin(x));
  298.     return UNSPECIFIC;}
  299.   FLOP2(12) {
  300.     get_float_arg(value, 0, x);
  301.     set_float_arg(value, 1, cos(x));
  302.     return UNSPECIFIC;}
  303.   FLOP2(13) {
  304.     get_float_arg(value, 0, x);
  305.     set_float_arg(value, 1, tan(x));
  306.     return UNSPECIFIC;}
  307.   FLOP2(14) {
  308.     get_float_arg(value, 0, x);
  309.     set_float_arg(value, 1, asin(x));
  310.     return UNSPECIFIC;}
  311.   FLOP2(15) {
  312.     get_float_arg(value, 0, x);
  313.     set_float_arg(value, 1, acos(x));
  314.     return UNSPECIFIC;}
  315.   FLOP3(16) {            /* atan */
  316.     get_float_arg(value, 0, y);
  317.     get_float_arg(value, 1, x);
  318.     set_float_arg(value, 2, atan2(y, x));
  319.     return UNSPECIFIC;}
  320.   FLOP2(17) {
  321.     get_float_arg(value, 0, x);
  322.     set_float_arg(value, 1, sqrt(x));
  323.     return UNSPECIFIC;}
  324.  
  325.   FLOP2(18) {            /* floor */
  326.     get_float_arg(value, 0, x);
  327.     set_float_arg(value, 1, floor(x));
  328.     return UNSPECIFIC;}
  329.   case FLOP+19: {        /* integer? */
  330.     EXTRACT_FLOAT(value, x);
  331.     return ENTER_BOOLEAN(fmod(x, 1.0) == 0.0); }
  332.   case FLOP+20: {        /* float->fixnum */
  333.     EXTRACT_FLOAT(value, x);
  334.     if (x <= (double)GREATEST_FIXNUM_VALUE
  335.     && x >= (double)LEAST_FIXNUM_VALUE)
  336.       return ENTER_FIXNUM((long)x);
  337.     else
  338.       return SCHFALSE;}
  339.   FLOP3(21) {            /* quotient */
  340.     double z;
  341.     get_float_arg(value, 0, x);
  342.     get_float_arg(value, 1, y);
  343.     if (fmod(x, 1.0) != 0.0 || fmod(y, 1.0) != 0.0) return UNDEFINED;
  344.     if (y == 0.0) return UNDEFINED;
  345.     z = x / y;
  346.     set_float_arg(value, 2, z < 0.0 ? ceil(z) : floor(z));
  347.     return UNSPECIFIC;}
  348.   FLOP3(22) {            /* remainder */
  349.     get_float_arg(value, 0, x);
  350.     get_float_arg(value, 1, y);
  351.     if (fmod(x, 1.0) != 0.0 || fmod(y, 1.0) != 0.0) return UNDEFINED;
  352.     if (y == 0.0) return UNDEFINED;
  353.  
  354.     /* "fmod(double x, double y) returns the floating-point remainder
  355.        (f) of the division of x by y, where f has the same sign as x,
  356.        such that x=iy+f for some integer i, and |f| < |y|." */
  357.  
  358.     set_float_arg(value, 2, fmod(x, y));
  359.     return UNSPECIFIC;}
  360.  
  361.   default:
  362.     return UNDEFINED;
  363.   }
  364. }
  365.  
  366.  
  367. FILE **
  368. port_to_stream(scheme_value port)
  369. {
  370.   int index;
  371.   extern FILE **Sopen_portsS;
  372.  
  373.   if (!PORTP(port))
  374.     return NULL;        /* not a port */
  375.  
  376.   index = PORT_INDEX(port);
  377.   if (index < 0)
  378.     return NULL;        /* port not open */
  379.  
  380.   return &Sopen_portsS[index];
  381. }
  382.